home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / sbprolog / amiga / v3_1 / sbp3_1e.lzh / FCHAIN.PL < prev    next >
Text File  |  1991-10-31  |  3KB  |  129 lines
  1. /* From the book PROLOG PROGRAMMING IN DEPTH
  2.    by Michael A. Covington, Donald Nute, and Andre Vellino.
  3.    Copyright 1988 Scott, Foresman & Co.
  4.    Non-commercial distribution of this file is permitted. */
  5. /* Modified for Quintus Prolog by Andreas Siebert */
  6.  
  7. /* FCHAIN.PL */
  8.  
  9. /* This file contains a simple forward chaining      */
  10. /* inference engine that accepts Prolog translations */
  11. /* of production rules, plus a supervisory program   */
  12. /* for use with the inference engine.                */
  13.  
  14.   cls :- nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl,nl.
  15.  
  16.  
  17. /*
  18.  * Supervisory program
  19.  */
  20.  
  21. :- dynamic goal/1, fact/1.
  22. :- multifile goal/1, fact/1.
  23.  
  24. fc :-
  25.     /*
  26.      * First, the supervisor prints an introductory
  27.      * message to the user.
  28.      */
  29.      cls,
  30.      write('FCHAIN - A Forward Chaining Inference Engine'),
  31.      nl, nl,
  32.      write('This is an interpreter for files containing production'),
  33.      nl,
  34.      write('rules written in the FCHAIN format.'),
  35.      nl, nl,
  36.      write('The > prompt accepts four commands:'), nl, nl,
  37.      write('load. - prompts for names of rules files'), nl,
  38.      write('        (enclose names in single quotes)'), nl,
  39.      write('list. - lists facts and goals in working'), nl,
  40.      write('        memory'),  nl,
  41.      write('go.   - starts the forward chainer'), nl, nl,
  42.      write('stop. - exits FCHAIN'), nl, nl,
  43.      /*
  44.       * Then the supervisor enters a simple read-evaluate
  45.       * loop that reads the user's commands and processes them.
  46.       */
  47.      repeat,
  48.      write('>'),
  49.      read(X),
  50.      /*
  51.       * If the command is to stop the supervisor,
  52.       * then the temporary database is erased and the
  53.       * supervisor succeeds. Otherwise, the user's
  54.       * command is passed on to the processing procedure.
  55.       * After the command is processed, the supervisor fails
  56.       * and execution backtracks to the 'repeat' goal above.
  57.       */
  58.      ( X = stop,abolish(fact,1),abolish(goal,1)
  59.        ;
  60.        process(X), nl, fail
  61.      ).
  62.  
  63. /*
  64.  * process(Command)
  65.  *   provides procedures for processing each of the
  66.  *   four kinds of commands the user may give to the
  67.  *   supervisor.
  68.  */
  69.  
  70. process(go) :- nl, forward_chainer.
  71.  
  72. process(go) :- !.  /* if forward_chainer failed */
  73.  
  74. process(load) :- nl, write('File name? '),
  75.                  read(Filename),
  76.                  reconsult(Filename), !.
  77.  
  78. process(list) :- nl, write('Facts:'),
  79.                  nl, fact(X),
  80.                  write('     '),
  81.                  write(X), nl, fail.
  82.  
  83. process(list) :- nl, write('Goals:'),
  84.                  nl, goal(X),
  85.                  write('     '),
  86.                  write(X), nl, fail.
  87.  
  88. process(list) :- !.
  89.  
  90. process(list(X)) :- nl, fact(X),
  91.                     write('     '),
  92.                     write(X), nl, fail.
  93.  
  94. process(list(_)) :- !.
  95.  
  96. /*
  97.  * forward-chainer
  98.  *   finds a production rule that can be fired,
  99.  *   fires it, and informs the user, then calls
  100.  *   itself to repeat the process.
  101.  */
  102.  
  103. forward_chainer :- rule(ID),
  104.                    write('Fired rule: '),
  105.                    write(ID),
  106.                    write('.'),
  107.                    nl, !,
  108.                    forward_chainer.
  109.  
  110. /*
  111.  * The remaining predicates are provided to make
  112.  * writing and reading production rules easier.
  113.  */
  114.  
  115. af(X) :- asserta(fact(X)).
  116.  
  117. rf(X) :- retract(fact(X)).
  118.  
  119. ag(X) :- assert(goal(X)).
  120.  
  121. rg(X) :- retract(goal(X)).
  122.  
  123. then.
  124.  
  125. /* Starting query */
  126.  
  127. start :- fc.
  128. :- start.
  129.